Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/magic/i/mtbuffer.i

Modula Implementation | 1997-10-26 | 5.5 KB | 172 lines

(*----------------------------------------------------------------------*
 *                                                                      *
 *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
 *               ÿ         ÿ            ÿ    ÿ          ÿ               *
 *----------------------------------------------------------------------*
 * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
 *----------------------------------------------------------------------*
 *            Dieses Modul ist urheberrechtlich geschtzt.              *
 *                                                                      *
 * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
 * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
 * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
 * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
 * Einverst„ndnisserkl„rung des Autors.                                 *
 *                                                                      *
 * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
 * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
 * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
 * widerrufen.                                                          *
 *----------------------------------------------------------------------*)

IMPLEMENTATION MODULE mtBuffer;

(*----------------------------------------------------------------------*
 * Int. Vers | Datum    | Name | Žnderung                               *
 *-----------+----------+------+----------------------------------------*
 *  3.00     | 18.01.92 |  Hp  |                                        *
 *-----------+----------+------+----------------------------------------*)



(* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
(*                                              *)
(*$R-   Range-Checks                            *)
(*$S-   Stack-Check                             *)
(*                                              *)
(*----------------------------------------------*)








FROM Storage IMPORT ALLOCATE, DEALLOCATE;




FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
                        Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
                        Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
                        sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
                        CastToChar, CastToByte, CastToByteset, CastToInt,
                        CastToCard, CastToBitset, CastToWord, CastToLInt,
                        CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
                        TosVersion, Accessory, Basepage, SysHeader, TosDate;






FROM SYSTEM     IMPORT  ADDRESS, ADR, TSIZE;

CONST   cMax =          07FFFH;

TYPE    INFO =          POINTER TO ARRAY [0..cMax] OF LOC;

TYPE    ENTRY =         POINTER TO Entry;
        Entry =         RECORD
                         addr: INFO;
                         size: sCARDINAL;
                         next: ENTRY;
                        END;

TYPE    BUFFER =        POINTER TO Buffer;
        Buffer =        RECORD
                         start: ENTRY;
                         end:   ENTRY;
                         entry: lCARDINAL;
                        END;

PROCEDURE Copy (from, to: INFO; size: sCARDINAL);
VAR c: sCARDINAL;
BEGIN
 FOR c:= 0 TO size DO to^[c]:= from^[c]; END;
END Copy;

PROCEDURE NewBuffer (VAR buffer: BUFFER): BOOLEAN;
BEGIN
 ALLOCATE (buffer,  TSIZE(Buffer));
 IF buffer = NIL THEN RETURN FALSE; END;
 buffer^.start:= NIL;  buffer^.end:= NIL;  buffer^.entry:= LONG (0);
 RETURN TRUE;
END NewBuffer;

PROCEDURE DisposeBuffer (VAR buffer: BUFFER);
VAR p: ENTRY;
BEGIN
 IF buffer # NIL THEN
  WITH buffer^ DO
   WHILE start # NIL DO
    p:= start^.next;
    DEALLOCATE (start^.addr, 0);
    DEALLOCATE (start, 0);
    start:= p;
   END;
  END;
  DEALLOCATE (buffer, 0);
 END;
END DisposeBuffer;

PROCEDURE BufferEmpty (buffer: BUFFER): BOOLEAN;
BEGIN
 IF buffer = NIL THEN  RETURN FALSE;  END;
 RETURN buffer^.start = NIL;
END BufferEmpty;

PROCEDURE BufferEntries (buffer: BUFFER): lCARDINAL;
BEGIN
 IF buffer = NIL THEN  RETURN LONG (0);
                 ELSE  RETURN buffer^.entry;
 END;
END BufferEntries;

PROCEDURE Put (buffer: BUFFER; info: ARRAY OF LOC): BOOLEAN;
VAR p: ENTRY;
BEGIN
 IF buffer = NIL THEN  RETURN FALSE;  END;
 ALLOCATE (p,  TSIZE(Entry));
 IF p = NIL THEN  RETURN FALSE;  END;
 p^.size:= HIGH (info);
 p^.next:= NIL;
 ALLOCATE (p^.addr,  LONG(p^.size));
 IF p^.addr = NIL THEN  DEALLOCATE (p, 0);   RETURN FALSE;  END;
 Copy (ADR(info), p^.addr, p^.size);
 WITH buffer^ DO
  IF end # NIL THEN
   end^.next:= p;  end:= p;
  ELSIF start # NIL THEN
   start^.next:= p;  start:= p;
  ELSE
   start:= p;  end:= p;
  END;
  INC (entry);
 END;
 RETURN TRUE;
END Put;

PROCEDURE Get (buffer: BUFFER; VAR info: ARRAY OF LOC): BOOLEAN;
VAR p: ENTRY;
BEGIN
 IF buffer = NIL THEN  RETURN FALSE;  END;
 WITH buffer^ DO
  IF start = NIL THEN  RETURN FALSE;  END;
  p:= start;
  IF HIGH (info) < p^.size THEN  RETURN FALSE;  END;
  Copy (p^.addr, ADR (info), p^.size);
  start:= p^.next;
  DEALLOCATE (p^.addr, 0);
  DEALLOCATE (p, 0);
  IF start = NIL THEN  end:= NIL;  END;
  DEC (entry);
 END;
 RETURN TRUE;
END Get;

END mtBuffer.